home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / custom / cus-dep.el.z / cus-dep.el
Encoding:
Text File  |  1998-05-21  |  6.5 KB  |  182 lines
  1. ;;; cus-dep.el --- Find customization dependencies.
  2. ;;
  3. ;; Copyright (C) 1997 Free Software Foundation, Inc.
  4. ;;
  5. ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>, then
  6. ;;         Richar Stallman <rms@gnu.ai.mit.edu>, then
  7. ;;         Hrvoje Niksic <hniksic@srce.hr>       (rewritten for XEmacs)
  8. ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
  9. ;; Keywords: internal
  10.  
  11. ;; This file is part of XEmacs.
  12.  
  13. ;; XEmacs is free software; you can redistribute it and/or modify
  14. ;; it under the terms of the GNU General Public License as published by
  15. ;; the Free Software Foundation; either version 2, or (at your option)
  16. ;; any later version.
  17.  
  18. ;; XEmacs is distributed in the hope that it will be useful,
  19. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ;; GNU General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with XEmacs; see the file COPYING.  If not, write to the
  25. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;; Boston, MA 02111-1307, USA.
  27.  
  28. ;;; Synched up with: Not synched with FSF.
  29.  
  30.  
  31. ;;; Commentary:
  32.  
  33. ;; This file generates the custom-load files, loaded by cus-load.el.
  34. ;; The only entry point is `Custom-make-dependencies'.
  35.  
  36. ;; It works by scanning all the `.el' files in a directory, and
  37. ;; evaluates any `defcustom', `defgroup', or `defface' expression that
  38. ;; it finds.  The symbol changed by this expression is stored to a
  39. ;; hash table as the hash key, file name being the value.
  40.  
  41. ;; After all the files have been examined, custom-loads.el is
  42. ;; generated by mapping all the atoms, and seeing if any of them
  43. ;; contains a `custom-group' property.  This property is a list whose
  44. ;; each element's car is the "child" group symbol.  If that property
  45. ;; is in the hash-table, the file name will be looked up from the
  46. ;; hash-table, and added to cusload-file.  Because the hash-table is
  47. ;; cleared whenever we process a new directory, we cannot get confused
  48. ;; by custom-loads from another directory, or from a previous
  49. ;; installation.  This is also why it is perfectly safe to have old
  50. ;; custom-loads around, and have them loaded by `cus-load.el' (as
  51. ;; invoked by `cus-edit.el').
  52.  
  53. ;; A trivial, but useful optimization is that if cusload-file exists,
  54. ;; and no .el files in the directory are newer than cusload-file, it
  55. ;; will not be generated.  This means that the directories where
  56. ;; nothing has changed will be skipped.
  57.  
  58. ;; The `custom-add-loads' function, used by files generated by
  59. ;; `Custom-make-dependencies' updates a symbol's `custom-loads'
  60. ;; property (which must be a list of strings) with a new list of
  61. ;; strings, eliminating the duplicates.  As it also adds an
  62. ;; appropriate entry to a custom hash-table.  It is defined in
  63. ;; `cus-load.el'.
  64.  
  65. ;; Example:
  66.  
  67. ;; (custom-add-loads 'foo '("bar" "baz"))
  68. ;; (get 'foo 'custom-loads)
  69. ;;   => ("bar" "baz")
  70. ;;
  71. ;; (custom-add-loads 'foo '("hmph" "baz" "quz"))
  72. ;; (get 'foo 'custom-loads)
  73. ;;   => ("bar" "baz" "hmph" "qux")
  74.  
  75. ;; Obviously, this allows correct incremental loading of custom-load
  76. ;; files.  This is not necessary under FSF (they use a simple `put'),
  77. ;; since they have only *one* file.  With the advent of packages, we
  78. ;; cannot afford the same luxury.
  79.  
  80.  
  81. ;;; Code:
  82.  
  83. (require 'cl)
  84. (require 'widget)
  85. (require 'cus-face)
  86.  
  87. ;; Don't change this, unless you plan to change the code in
  88. ;; cus-start.el, too.
  89. (defconst cusload-base-file "custom-load.el")
  90.  
  91. ;; Be very careful when changing this function.  It looks easy to
  92. ;; understand, but is in fact very easy to break.  Be sure to read and
  93. ;; understand the commentary above!
  94.  
  95. ;;;###autoload
  96. (defun Custom-make-dependencies (&optional subdirs)
  97.   "Extract custom dependencies from .el files in SUBDIRS.
  98. SUBDIRS is a list of directories.  If it is nil, the command-line
  99. arguments are used.  If it is a string, only that directory is
  100. processed.  This function is especially useful in batch mode.
  101.  
  102. Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS"
  103.   (interactive "DDirectory: ")
  104.   (and (stringp subdirs)
  105.        (setq subdirs (list subdirs)))
  106.   (or subdirs
  107.       ;; Usurp the command-line-args
  108.       (setq subdirs command-line-args-left
  109.         command-line-args-left nil))
  110.   (setq subdirs (mapcar #'expand-file-name subdirs))
  111.   (with-temp-buffer
  112.     (let ((enable-local-eval nil)
  113.       (hash (make-hash-table :test 'eq)))
  114.       (dolist (dir subdirs)
  115.     (princ (format "Processing %s\n" dir))
  116.     (let ((cusload-file (expand-file-name cusload-base-file dir))
  117.           (files (directory-files dir t "\\`[^=].*\\.el\\'")))
  118.       ;; A trivial optimization: if no file in the directory is
  119.       ;; newer than custom-load.el, no need to do anything!
  120.       (if (and (file-exists-p cusload-file)
  121.            (dolist (file files t)
  122.              (when (file-newer-than-file-p file cusload-file)
  123.                (return nil))))
  124.           (princ "(No changes need to be written)\n")
  125.         ;; Process directory
  126.         (dolist (file files)
  127.           (when (file-exists-p file)
  128.         (erase-buffer)
  129.         (insert-file-contents file)
  130.         (goto-char (point-min))
  131.         (let ((name (file-name-sans-extension
  132.                  (file-name-nondirectory file))))
  133.           ;; Search for defcustom/defface/defgroup
  134.           ;; expressions, and evaluate them.
  135.           (ignore-errors
  136.             (while (re-search-forward
  137.                 "^(defcustom\\|^(defface\\|^(defgroup"
  138.                 nil t)
  139.               (beginning-of-line)
  140.               (let ((expr (read (current-buffer))))
  141.             (eval expr)
  142.             ;; Hash the file of the affected symbol.
  143.             (setf (gethash (nth 1 expr) hash) name)))))))
  144.         (cond
  145.          ((zerop (hash-table-count hash))
  146.           (princ "(No customization dependencies")
  147.           (when (file-exists-p cusload-file)
  148.         (princ (format ", deleting %s" cusload-file))
  149.         (delete-file cusload-file))
  150.           (princ ")\n"))
  151.          (t
  152.           (princ (format "Generating %s...\n" cusload-base-file))
  153.           (with-temp-file cusload-file
  154.         (insert ";;; " cusload-base-file
  155.             " --- automatically extracted custom dependencies\n"
  156.             "\n\n;;; Code:\n\n")
  157.         (mapatoms
  158.          (lambda (sym)
  159.            (let ((members (get sym 'custom-group))
  160.              item where found)
  161.              (when members
  162.                (while members
  163.              (setq item (car (car members))
  164.                    members (cdr members)
  165.                    where (gethash item hash))
  166.              (unless (or (null where)
  167.                      (member where found))
  168.                (if found
  169.                    (insert " ")
  170.                  (insert "(custom-add-loads '"
  171.                      (symbol-name sym) " '("))
  172.                (prin1 where (current-buffer))
  173.                (push where found)))
  174.                (when found
  175.              (insert "))\n"))))))
  176.         (insert "\n;;; custom-load.el ends here\n"))
  177.           (clrhash hash)))))))))
  178.  
  179. (provide 'cus-dep)
  180.  
  181. ;;; cus-dep.el ends here
  182.